perm filename DVIESP.CH[TEX,SYS]3 blob sn#797921 filedate 1985-07-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	@x Tell WEAVE to print only the changes:
C00003 00003	@x Printing goes to terminal
C00004 00004	@x Specify compiler directives:
C00005 00005	@x Opening packed binary files:
C00012 00006	@x Set up terminal I/O:
C00014 00007	@x The default font directory:
C00016 00008	@x Change to file name conventions:
C00020 00009	@x Change to tfm file name conventions:
C00024 00010	@x user and file id
C00028 00011	@x esp
C00029 00012	@x file_name type
C00031 ENDMK
C⊗;
@x Tell WEAVE to print only the changes:
	\centerline{\hsize 5in\baselineskip9pt
		\vbox{\ninerm\noindent
		The preparation of this report
		was supported in part by the National Science
		Foundation under grants IST-8201926 and MCS-8300984,
		and by the System Development Foundation. `\TeX' is a
		trademark of the American Mathematical Society.}}}
@y
\centerline{(This listing shows the changes for {\sc WAITS} only)}}
\let\maybe=\iffalse
@z
@x Printing goes to terminal
@d print(#)==write(#)
@d print_ln(#)==write_ln(#)
@d print_nl==write_ln
@y
@d print(#)==write(tty,#)
@d print_ln(#)==write_ln(tty,#)
@d print_nl==write_ln(tty)
@z
@x Specify compiler directives:
@p program DVI_IMP(@!dvi_file,@!im_file,@!output);
@y
@p @t\4@>@{$D+,W+@} {no debugging overhead}
program DVI_IMP;
@z
@x Opening packed binary files:
@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
begin reset(dvi_file);
cur_loc←0;
end;
@#
procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file,cur_name);
cur_gf_loc←0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin reset(tfm_file,cur_tfm_name);
end;
@y
@p procedure esp(var dvi_file,im_file:f@&i@&l@&e); extern; @t\2@>@/
	{spools the |im_file| under the |dvi_file| name}
@#
function rescan:boolean; extern; @t\2@>@;
	{puts the command line into the terminal buffer,
	or returns |false| if there was no command line}
@#
procedure cur_nam(var chan:f@&i@&l@&e;var s:string); extern; @t\2@>@/
@#
function erstat(var f:file):integer; extern;@t/2@>
@#
procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
label 223;
var i:integer;
@!seen_dot, @!seen_left_bracket, @!seen_right_bracket: boolean;
@!seen_slash: boolean;
begin
if rescan then begin
	read_ln(tty);
	while (¬ eoln(tty))∧(tty↑≠';') do get(tty);
	end;
if eoln(tty) then write(tty,'DVI file? ');
223:
i←1;
get(tty);
seen_dot←false; seen_left_bracket←false; seen_right_bracket←false;
seen_slash←false;
while (¬ eoln(tty)) and (not seen_slash) do begin
	if tty↑='.' then seen_dot←true
	else if tty↑=']' then seen_right_bracket←true
	else if tty↑='[' then begin
		if not seen_dot then begin
			seen_dot←true;
			dvi_name[i]←'.'; incr(i);
			dvi_name[i]←'D'; incr(i);
			dvi_name[i]←'V'; incr(i);
			dvi_name[i]←'I'; incr(i);
			end;
		seen_left_bracket←true
		end;
	if tty↑='/' then seen_slash←true
	else begin dvi_name[i]←tty↑; incr(i); get(tty); end;
	end;
if not seen_dot then begin
	dvi_name[i]←'.'; incr(i);
	dvi_name[i]←'D'; incr(i);
	dvi_name[i]←'V'; incr(i);
	dvi_name[i]←'I'; incr(i);
	end;
if seen_left_bracket and not seen_right_bracket then begin
	dvi_name[i]←']'; incr(i);
	end;
spoolit←true;
while (seen_slash) and (¬ eoln(tty)) do begin
    get(tty);
    if (tty↑='c') or (tty↑='C') then read_c
    else if (tty↑='f') or (tty↑='F') then read_f
    else if (tty↑='n') or (tty↑='N') then read_n
    else if (tty↑='i') or (tty↑='I') then begin spoolit←false; get(tty); end;
    if tty↑='/' then seen_slash←true else seen_slash←false;
    end;
reset(dvi_file,dvi_name,'/B:8/N:9/O');
if (erstat(dvi_file) mod @'20000) > 0 then begin
	write(tty,'.DVI file? ');
	goto 223;
	end;
cur_loc←0;
end;
@#
procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file,cur_name,'/B:8/O/N:9');
cur_gf_loc←0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin reset(tfm_file,cur_tfm_name,'/B:8/O/N:9');
cur_gf_loc←0;
end;
@z

@x
@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
begin rewrite(im_file); im_byte_no←0;
end;
@y
@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
label done;
var i,j:integer;
begin
cur_nam(dvi_file,imp_name);
i←1;
while (imp_name[i]>'.') and (imp_name[i]≠'[') do
	incr(i); {skip to dot or bracket or space or null}
if spoolit then begin
	j←i-1;
	imp_name[i]←'.'; incr(i);
	imp_name[i]←'L'; incr(i);
	imp_name[i]←'P'; incr(i);
	imp_name[i]←'T'; incr(i);
	imp_name[i]←'['; incr(i);
	imp_name[i]←'S'; incr(i);
	imp_name[i]←'P'; incr(i);
	imp_name[i]←'L'; incr(i);
	imp_name[i]←','; incr(i);
	imp_name[i]←'S'; incr(i);
	imp_name[i]←'Y'; incr(i);
	imp_name[i]←'S'; incr(i);
	imp_name[i]←']'; incr(i);
	while i<f_name_size do begin
		imp_name[i]←' ';
		incr(i);
		end;
	while true do begin
		reset(im_file,imp_name,'/O');
		if (erstat(im_file) mod @'20000)>0 then goto done;
		imp_name[j]←chr(ord(imp_name[j])+1);
		if imp_name[j]>'Z' then begin
			imp_name[j-1]←chr(ord(imp_name[j-1])+1);
			imp_name[j]←'A';
			if imp_name[j-1]>'Z' then imp_name[j-1]←'A';
			end;
		end;
	done:
	end
else begin
	imp_name[i]←'.'; incr(i);
	imp_name[i]←'I'; incr(i);
	imp_name[i]←'M'; incr(i);
	imp_name[i]←'P'; incr(i);
	while i<f_name_size do begin
		imp_name[i]←' ';
		incr(i);
		end;
	end;
rewrite(im_file,imp_name,'/B:8/N:9/P:256');
im_byte_no←0;
end;
@z
@x Set up terminal I/O:
and |term_out| for terminal output.
@↑system dependencies@>

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@!term_in:text_file; {the terminal, considered as an input file}
@!term_out:text_file; {the terminal, considered as an output file}
@y
and |term_out| for terminal output.
@↑system dependencies@>

@d term_in==tty
@d term_out==tty

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of ASCII_code;
@z
@x The default font directory:
@d default_directory_name=='TeXfonts:' {change this to the correct name}
@d default_directory_name_length=9 {change this to the correct length}
@d dflt_tfm_directory_name=='TeXfonts:' {change this to the correct name}
@d dflt_tfm_directory_name_length=9 {change this to the correct length}
@y
@d default_directory_name=='[GF,SYS]' {change this to the correct name}
@d default_directory_name_length=8 {change this to the correct length}
@d dflt_tfm_directory_name=='[TEX,SYS]' {change this to the correct name}
@d dflt_tfm_directory_name_length=9 {change this to the correct length}
@z
@x Change to file name conventions:
@ The string |cur_name| is supposed to be set to the external name of the
\.{GF} file for the current font. This usually means that we need to
prepend the name of the default directory, and
to append the suffix `\.{.GF}'. Furthermore, we change lower case letters
to upper case, since |cur_name| is a \PASCAL\ string.
@↑system dependencies@>

@<Move font name into the |cur_name| string@>=
for k←1 to name_length do cur_name[k]←' ';
if p=0 then
	begin for k←1 to default_directory_name_length do
		cur_name[k]←default_directory[k];
	r←default_directory_name_length;
	end
else r←0;
for k←font_name[cur_font] to font_name[cur_font+1]-1 do
	begin incr(r);
	if r+4>name_length then
		abort('DVIIMP capacity exceeded (max font name length=',
			name_length:1,')!');
@.DVIIMP capacity exceeded...@>
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_name[r]←xchr[names[k]-@'40]
	else cur_name[r]←xchr[names[k]];
	end;
cur_name[r+1]←'.'; cur_name[r+2]←'G'; cur_name[r+3]←'F';
{|cur_name[r+4]←'M';|}
@y
@ The string |cur_name| is supposed to be set to the external name of the
\.{GF} file for the current font. This usually means that we need to
prepend the name of the default directory, and
to append the suffix `\.{.GF}'. But at {\mc SAIL} we append the
directory name after the font name. And we compress `\.{oldenglish}' to
`\.{oldish}'.
@↑system dependencies@>

@<Move font name into the |cur_name| string@>=
for k←1 to name_length do cur_name[k]←' ';
r←0;
for k←font_name[cur_font]+p to font_name[cur_font+1]-1 do
    if (k≤font_name[cur_font]+p+2)∨(k≥font_name[cur_font+1]-3) then
	begin incr(r);
	if r+4>name_length then
		abort('DVItype capacity exceeded (max font name length=',
			name_length:1,')!');
@.DVItype capacity exceeded...@>
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_name[r]←xchr[names[k]-@'40]
	else cur_name[r]←xchr[names[k]];
	end;
m←font_m_val[cur_font];

cur_name[r+1]←'.';
cur_name[r+2]← xchr[m div 100+@'60];
cur_name[r+3]← xchr[(m mod 100) div 10+@'60];
cur_name[r+4]← xchr[m mod 10+@'60];

r←r+4;
if p=0 then for k←1 to default_directory_name_length do
	begin incr(r);
	if r>name_length then abort('Font name is too long!');
	cur_name[r]←default_directory[k];
	end
else for k←font_name[cur_font] to font_name[cur_font]+p-1 do
	begin incr(r);
	if r>name_length then abort('Font name is too long!');
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_name[r]←xchr[names[k]-@'40]
	else cur_name[r]←xchr[names[k]];
	end
@z
@x Change to tfm file name conventions:
@ Normally, we only need to reference the \.{GF} files.  On those
occasions when no \.{GF} file is to be found we will want to obtain the
glyph widths from a \.{TFM} file.
The following module takes care of setting the external name of this
\.{TFM} file.

@<Move font name into the |cur_tfm_name| string@>=
for k←1 to name_length do cur_tfm_name[k]←' ';
if p=0 then
	begin for k←1 to dflt_tfm_directory_name_length do
		cur_tfm_name[k]←dflt_tfm_directory[k];
	r←dflt_tfm_directory_name_length;
	end
else r←0;
for k←font_name[cur_font] to font_name[cur_font+1]-1 do
	begin incr(r);
	if r+4>name_length then
		abort('DVIIMP capacity exceeded (max font name length=',
			name_length:1,')!');
@.DVIIMP capacity exceeded...@>
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_tfm_name[k]←xchr[names[k]-@'40]
	else cur_tfm_name[r]←xchr[names[k]];
	end;
cur_tfm_name[r+1]←'.'; cur_tfm_name[r+2]←'T';
cur_tfm_name[r+3]←'F'; cur_tfm_name[r+4]←'M';
@y
@ Normally, we only need to reference the \.{GF} files.  On those
occasions when no \.{GF} file is to be found we will want to obtain the
glyph widths from a \.{TFM} file.
The following takes care of {\mc SAIL} conventions.

@<Move font name into the |cur_tfm_name| string@>=
for k←1 to name_length do cur_tfm_name[k]←' ';
r←0;
for k←font_name[cur_font]+p to font_name[cur_font+1]-1 do
    if (k≤font_name[cur_font]+p+2)∨(k≥font_name[cur_font+1]-3) then
	begin incr(r);
	if r+4>name_length then
		abort('DVItype capacity exceeded (max font name length=',
			name_length:1,')!');
@.DVItype capacity exceeded...@>
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_tfm_name[r]←xchr[names[k]-@'40]
	else cur_tfm_name[r]←xchr[names[k]];
	end;
cur_tfm_name[r+1]←'.'; cur_tfm_name[r+2]←'T';
cur_tfm_name[r+3]←'F'; cur_tfm_name[r+4]←'M';

r←r+4;
if p=0 then for k←1 to dflt_tfm_directory_name_length do
	begin incr(r);
	if r>name_length then abort('Font name is too long!');
	cur_tfm_name[r]←dflt_tfm_directory[k];
	end
else for k←font_name[cur_font] to font_name[cur_font]+p-1 do
	begin incr(r);
	if r>name_length then abort('Font name is too long!');
	if (names[k]≥"a")∧(names[k]≤"z") then
			cur_tfm_name[r]←xchr[names[k]-@'40]
	else cur_tfm_name[r]←xchr[names[k]];
	end
@z
@x user and file id
open_im_file;
@y
open_im_file;
im_byte("@@");
im_byte("d");
im_byte("o");
im_byte("c");
im_byte("u");
im_byte("m");
im_byte("e");
im_byte("n");
im_byte("t");
im_byte("(");

im_byte("p");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte("r");
im_byte("e");
im_byte("v");
im_byte("e");
im_byte("r");
im_byte("s");
im_byte("a");
im_byte("l");
im_byte(" ");
im_byte("o");
im_byte("f");
im_byte("f");
im_byte(",");
im_byte(" ");

im_byte("p");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte("c");
im_byte("o");
im_byte("l");
im_byte("l");
im_byte("a");
im_byte("t");
im_byte("i");
im_byte("o");
im_byte("n");
im_byte(" ");
im_byte("o");
im_byte("f");
im_byte("f");
im_byte(",");
im_byte(" ");

im_byte("l");
im_byte("a");
im_byte("n");
im_byte("g");
im_byte("u");
im_byte("a");
im_byte("g");
im_byte("e");
im_byte(" ");
im_byte("i");
im_byte("m");
im_byte("P");
im_byte("r");
im_byte("e");
im_byte("s");
im_byte("s");
im_byte(",");
im_byte(" ");
im_byte("O");
im_byte("w");
im_byte("n");
im_byte("e");
im_byte("r");
im_byte(" ");
im_byte("""");
calli(@'24,0,0,ppn.int,success);
for dvi_n_len←1 to 6 do im_byte(ppn.sixbit[dvi_n_len]+@'40);
im_byte("""");
im_byte(",");
im_byte("N");
im_byte("a");
im_byte("m");
im_byte("e");
im_byte(" ");
im_byte("""");
cur_nam(dvi_file,dvi_name);
dvi_n_len←1;
while ord(dvi_name[dvi_n_len])≠0 do
	begin im_byte(xord[dvi_name[dvi_n_len]]); incr(dvi_n_len);
	end;
im_byte("""");
im_byte(",");
im_byte("D");
im_byte("V");
im_byte("I");
im_byte("-");
im_byte("i");
im_byte("d");
im_byte(" ");
im_byte("""");
for p←0 to id_len do im_byte(id[p]);
im_byte("""");
im_byte(")");
@z
@x esp
final_end:end.
@y
final_end:
close(im_file); close(dvi_file);
if spoolit then esp(dvi_file,im_file);
end.
@z
@x file_name type
itself will get a new section number.
@↑system dependencies@>
@y
itself will get a new section number.
@↑system dependencies@>

@<Const...@>=
@!f_name_size=24;

@ @<Type...@>=
@!file_name=packed array[1..f_name_size] of char;

@ @<Glob...@>=
@!imp_name,
@!dvi_name:file_name;
@!dvi_n_len:1..f_name_size;
	{file names at {\sc SAIL} have at most 23 characters}
@!ppn:record case integer of
	1: (@!int: integer);
	2: (@!sixbit: packed array[1..6] of 0..@'77)
	end;
@!success:boolean;
@!spoolit: boolean;
@z